perm filename BASIC.LSP[206,JMC]2 blob
sn#072129 filedate 1973-11-14 generic text, type T, neo UTF8
00100
00200
00300 (DEFPROP BASICFNS
00400 (BASICFNS ORLIS ANDLIS MAPCAR2 MAPCHOOSE MAPAPP PRUP LISTSUBT LISTSUBTA CONTAINED DELETE PICKOUT PICKOUTA)
00500 VALUE)
00600
00700 (DEFPROP ORLIS
00800 (LAMBDA (PRED U) (AND (NOT (NULL U)) (OR (PRED (CAR U)) (ORLIS PRED (CDR U)))))
00900 EXPR)
01000
01100 (DEFPROP ANDLIS
01200 (LAMBDA (PRED U) (OR (NULL U) (AND (PRED (CAR U)) (ANDLIS PRED (CDR U)))))
01300 EXPR)
01400
01500 (DEFPROP MAPCAR2
01600 (LAMBDA (FN U V) (COND ((NULL U) NIL) (T (CONS (FN (CAR U) (CAR V)) (MAPCAR2 FN (CDR U) (CDR V))))))
01700 EXPR)
01800
01900 (DEFPROP MAPCHOOSE
02000 (LAMBDA(PRED FN U)
02100 (COND ((NULL U) NIL)
02200 ((PRED (CAR U)) (CONS (FN (CAR U)) (MAPCHOOSE PRED FN (CDR U))))
02300 (T (MAPCHOOSE PRED FN (CDR U)))))
02400 EXPR)
02500
02600 (DEFPROP MAPAPP
02700 (LAMBDA (FN U) (COND ((NULL U) NIL) (T (APPEND (FN (CAR U)) (MAPAPP FN (CDR U))))))
02800 EXPR)
02900
03000 (DEFPROP PRUP
03100 (LAMBDA(U V)
03200 (COND ((NULL U) (COND ((NULL V) NIL) (T (ERROR (QUOTE (V LONGER - PRUP))))))
03300 ((NULL V) (ERROR (QUOTE (U LONGER - PRUP))))
03400 (T (CONS (CONS (CAR U) (CAR V)) (PRUP (CDR U) (CDR V))))))
03500 EXPR)
03600
03700 (DEFPROP LISTSUBT
03800 (LAMBDA (U V) (LISTSUBTA U (DIFFERENCE (LENGTH U) (LENGTH V)) NIL))
03900 EXPR)
04000
04100 (DEFPROP LISTSUBTA
04200 (LAMBDA (U N Z) (COND ((EQUAL N 0) Z) (T (LISTSUBTA (CDR U) (SUB1 N) (CONS (CAR U) Z)))))
04300 EXPR)
04400
04500 (DEFPROP CONTAINED
04600 (LAMBDA (U V) (OR (NULL U) (AND (MEMBER (CAR U) V) (CONTAINED (CDR U) V))))
04700 EXPR)
04800
04900 (DEFPROP DELETE
05000 (LAMBDA (X U) (COND ((NULL U) NIL) ((EQUAL X (CAR U)) (CDR U)) (T (CONS (CAR U) (DELETE X (CDR U))))))
05100 EXPR)
05200
05300 (DEFPROP PICKOUT
05400 (LAMBDA (PRED U) (PICKOUTA PRED U NIL NIL))
05500 EXPR)
05600
05700 (DEFPROP PICKOUTA
05800 (LAMBDA(PRED U X Y)
05900 (COND ((NULL U) (CONS X Y))
06000 ((PRED (CAR U)) (PICKOUTA PRED (CDR U) (CONS (CAR U) X) Y))
06100 (T (PICKOUTA PRED (CDR U) X (CONS (CAR U) Y)))))
06200 EXPR)